C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.4
C---------------------------------------------------------
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.4
C---------------------------------------------------------
 
C The following defines must have these values as OUTTOK/RDTOK expect
C them to - if they must be changed, look at OUTTOK & RDTOK.
 
 
        SUBROUTINE POLOPT(SPEC,ISSED)
        INTEGER SPEC(*)
        LOGICAL ISSED
 
C ------------------------------------------------------------------------
C
C       P O L O P T  -  set POLish OPTion
C
C ------------------------------------------------------------------------
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.4
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
        COMMON/MARGIN/LMARGS,RMARGS,LMARGC,RMARGC
        INTEGER LMARGS,RMARGS,LMARGC,RMARGC
 
        COMMON/CONTIN/CONCHR,CONCNT
        INTEGER CONCHR,CONCNT
 
        COMMON/LFORM/LABELF,LABELC
        INTEGER LABELF,LABELC
 
        COMMON/INDENT/INDDO,INDIF,INDCON,INDCMT,MAXIND
        INTEGER INDDO,INDIF,INDCON,MAXIND
        LOGICAL INDCMT
 
        COMMON/SEQNUM/SEQINI,SEQINC,SEQDIG,SEQFIL,SEQRQD
        INTEGER SEQINI,SEQINC,SEQDIG,SEQFIL
        LOGICAL SEQRQD
 
        COMMON/SPACNG/SPBEF,SPAFT
        INTEGER SPBEF(-2:TKLAST,0:2),SPAFT(-2:TKLAST,0:2)
 
        COMMON/INTBRK/BRPRIO
        INTEGER BRPRIO(-2:TKLAST,0:2)
 
        COMMON/BLINES/BLAFT,BLBEF,BLADEC,BLCHAR
        INTEGER BLAFT(-2:TKLAST),BLBEF(-2:TKLAST),BLCHAR
        LOGICAL BLADEC
 
        COMMON/RELBL/FLBINI,FLBINC,SLBINI,SLBINC,RLBFMT,RLBSTM
        INTEGER FLBINI,FLBINC,SLBINI,SLBINC
        LOGICAL RLBFMT,RLBSTM
 
        COMMON/DOCON/DOCONI,NDOCON,DOCONS,IOTHCO
        LOGICAL DOCONI,IOTHCO
        INTEGER NDOCON,DOCONS(30)
 
        COMMON/CMT/CMMODE,CBOX,CBTOP,CBSIDE,CMCHAR
        INTEGER CMMODE,CBOX,CBTOP,CBSIDE,CMCHAR
 
        COMMON/CASE/KWCASE,IDCASE,STRCAS,CMCASE,FFCASE
        INTEGER KWCASE,IDCASE,STRCAS,CMCASE,FFCASE
 
        COMMON/ASGLUP/VLEN
        INTEGER VLEN
 
        COMMON/MOVFMT/MOVEF,MFFLAG
        LOGICAL MOVEF,MFFLAG
 
        COMMON/OPTLCL/LHS,RHS,LPPOS,QUERY
        INTEGER LHS(134),RHS(134),LPPOS
        LOGICAL QUERY
 
        COMMON/DECLUP/DLUP,DLEN,DLUPOS
        LOGICAL DLUP
        INTEGER DLEN,DLUPOS
 
        COMMON/TRCOPT/TRACE
        LOGICAL TRACE
 
        COMMON/OPT15C/INDDOC,DELSED,BRKLIF
        LOGICAL INDDOC,DELSED,BRKLIF
 
        COMMON/ERROPT/ERRCMT
        LOGICAL ERRCMT
 
        COMMON/CVTOPT/CVTHFM,FMSBRK
        LOGICAL CVTHFM,FMSBRK
 
        COMMON/REMTOK/RMOPCF
        LOGICAL RMOPCF
 
        INTEGER PARTBL(355),XOPTBL(20),BOXTBL(25),KWCTBL(31),CASTBL(35)
        INTEGER IDCTBL(56),CMMTBL(46),CONTBL(33),LBFTBL(44)
        INTEGER BOXTBX(3),KWCTBX(3),CASTBX(3),IDCTBX(5),CMMTBX(4),
     +          CONTBX(3),LBFTBX(3)
 
        LOGICAL FIRST
 
        SAVE
 
        INTEGER OPTNUM,I,J,STATUS,TMP
        CHARACTER*132 ERRTXT
 
        INTEGER ZKWLUK,ZSPLIT,INDEXX,ZYESNO
        EXTERNAL ZKWLUK,ZSPLIT,INDEXX,ZITOF,REMARK,ZYESNO
 
        DATA (PARTBL(I),I=1,125)/53,
     +          98,108,97,100,101,99,129,
     +          98,108,97,102,116,129,
     +          98,108,98,101,102,129,
     +          98,108,99,104,97,114,129,
     +          98,114,107,108,105,102,129,
     +          98,114,112,114,105,111,129,
     +          99,98,111,120,129,
     +          99,98,115,105,100,101,129,
     +          99,98,116,111,112,129,
     +          99,109,99,97,115,101,129,
     +          99,109,99,104,97,114,129,
     +          99,109,109,111,100,101,129,
     +          99,111,110,99,104,114,129,
     +          99,118,116,104,102,109,129,
     +          100,101,108,115,101,100,129,
     +          100,108,101,110,129,
     +          100,108,117,112,129,
     +          100,111,99,111,110,105,129,
     +          101,114,114,99,109,116,129/
        DATA (PARTBL(I),I=126,235)/
     +          102,102,99,97,115,101,129,
     +          102,108,98,105,110,99,129,
     +          102,108,98,105,110,105,129,
     +          102,109,115,98,114,107,129,
     +          105,100,99,97,115,101,129,
     +          105,110,100,99,109,116,129,
     +          105,110,100,99,111,110,129,
     +          105,110,100,100,111,129,
     +          105,110,100,100,111,99,129,
     +          105,110,100,105,102,129,
     +          105,111,116,104,99,111,129,
     +          107,119,99,97,115,101,129,
     +          108,97,98,101,108,99,129,
     +          108,97,98,101,108,102,129,
     +          108,109,97,114,103,99,129,
     +          108,109,97,114,103,115,129/
        DATA (PARTBL(I),I=236,355)/
     +          109,111,118,101,102,129,
     +          114,108,98,102,109,116,129,
     +          114,108,98,115,116,109,129,
     +          114,109,97,114,103,99,129,
     +          114,109,97,114,103,115,129,
     +          114,109,111,112,99,102,129,
     +          115,101,113,100,105,103,129,
     +          115,101,113,102,105,108,129,
     +          115,101,113,105,110,99,129,
     +          115,101,113,105,110,105,129,
     +          115,101,113,114,113,100,129,
     +          115,108,98,105,110,99,129,
     +          115,108,98,105,110,105,129,
     +          115,112,97,102,116,129,
     +          115,112,98,101,102,129,
     +          115,116,114,99,97,115,129,
     +          116,114,97,99,101,129,
     +          118,108,101,110,129/
 
        DATA XOPTBL/2,
     +       110,97,103,95,115,116,97,110,100,97,
     +114,100,129,
     +       113,117,101,114,121,129/
 
        DATA BOXTBL/3,
     +       104,97,108,102,95,98,111,120,129,
     +       110,111,110,101,129,
     +       119,104,111,108,101,95,98,111,120,129/
 
        DATA KWCTBL/3,
     +       108,111,119,101,114,99,97,115,101,129,
     +       109,105,120,101,100,99,97,115,101,129,
     +       117,112,112,101,114,99,97,115,101,129/
 
        DATA CASTBL/3,
     +       108,111,119,101,114,99,97,115,101,129,
     +       111,114,105,103,105,110,97,108,95,
     +99,97,115,101,129,
     +       117,112,112,101,114,99,97,115,101,129/
 
        DATA IDCTBL/5,
     +       105,110,118,101,114,116,99,97,115,101,129,
     +       108,111,119,101,114,99,97,115,101,129,
     +       109,105,120,101,100,99,97,115,101,129,
     +       111,114,105,103,105,110,97,108,95,99,
     +97,115,101,129,
     +       117,112,112,101,114,99,97,115,101,129/
 
        DATA CMMTBL/4,
     +       110,111,114,109,97,108,129,
     +       115,107,105,112,95,108,101,97,100,105,
     +110,103,95,98,108,97,110,107,115,129,
     +       116,114,117,110,99,97,116,101,129,
     +       118,101,114,98,97,116,105,109,129/
 
        DATA CONTBL/3,
     +       97,108,112,104,97,98,101,116,105,99,129,
     +       97,108,112,104,97,110,117,109,101,114,105,
     +99,129,
     +       110,117,109,101,114,105,99,129/
 
        DATA LBFTBL/3,
     +       108,101,102,116,95,106,117,115,116,105,
     +102,105,101,100,129,
     +       114,105,103,104,116,95,106,117,115,116,
     +105,102,105,101,100,129,
     +       122,101,114,111,95,112,97,100,100,101,
     +100,129/
 
        DATA BOXTBX/1,0,2/,KWCTBX/1,2,0/,CASTBX/2,0,1/,IDCTBX/4,2,3,0,1/
        DATA CMMTBX/0,1,3,2/,CONTBX/2,3,1/,LBFTBX/0,1,2/
 
        DATA FIRST/.TRUE./
 
        IF (FIRST) THEN
            FIRST=.FALSE.
            QUERY=.FALSE.
        END IF
        STATUS=ZSPLIT(SPEC,LHS,RHS)
        LPPOS=INDEXX(LHS,40)
        IF (LPPOS.GT.0) LHS(LPPOS)=129
        OPTNUM=ZKWLUK(LHS,PARTBL)
        IF (LPPOS.GT.0) LHS(LPPOS)=40
        IF (OPTNUM.GT.0) THEN
            GOTO (1001,1002,1003,1004,1005,1006,1007,1008,1009,1010,
     +            1011,1012,1013,1014,1015,1016,1017,1018,1019,1020,
     +            1021,1022,1023,1024,1025,1026,1027,1028,1029,1030,
     +            1031,1032,1033,1034,1035,1036,1037,1038,1039,1040,
     +            1041,1042,1043,1044,1045,1046,1047,1048,1049,1050,
     +            1051,1052,1053) OPTNUM
        ELSE
            IF (STATUS.EQ.-1 .AND. LPPOS.EQ.0) THEN
                OPTNUM=ZKWLUK(LHS,XOPTBL)
            END IF
            IF (OPTNUM.GT.0) THEN
                GOTO (5000,5100) OPTNUM
            ELSE
                CALL ZITOF(LHS,1,132,ERRTXT,.TRUE.)
                CALL REMARK('Unknown Option Ignored: '//ERRTXT)
            END IF
        END IF
        RETURN
 
 1001   CALL SETLOG(BLADEC)
        RETURN
 
 1002   CALL SETVEC(BLAFT)
        RETURN
 
 1003   CALL SETVEC(BLBEF)
        RETURN
 
 1004   CALL SETCHR(BLCHAR)
        RETURN
 
 1005   CALL SETLOG(BRKLIF)
        RETURN
 
 1006   CALL SETVC2(BRPRIO)
        RETURN
 
 1007   IF (ISSED) THEN
            CALL REMARK('Cannot change CBOX in a SED')
        ELSE
            CALL SETKEY(CBOX,BOXTBL,BOXTBX)
        END IF
        RETURN
 
 1008   CALL SETCHR(CBSIDE)
        RETURN
 
 1009   CALL SETCHR(CBTOP)
        RETURN
 
 1010   CALL SETKEY(CMCASE,CASTBL,CASTBX)
        RETURN
 
 1011   CALL SETCHR(CMCHAR)
        RETURN
 
 1012   CALL SETKEY(CMMODE,CMMTBL,CMMTBX)
        RETURN
 
 1013   IF (RHS(1).EQ.39) THEN
            TMP=CONCHR
            CALL SETCHR(TMP)
            IF (TMP.EQ.32 .OR. TMP.EQ.48) THEN
                CALL BADVAL
            ELSE
                CONCHR=TMP
            END IF
        ELSE
            CALL SETKEY(CONCHR,CONTBL,CONTBX)
        END IF
        RETURN
 
 1014   CALL SETLOG(CVTHFM)
        RETURN
 
 1015   CALL SETLOG(DELSED)
        RETURN
 
 1016   CALL SETINT(DLEN,0,50)
        RETURN
 
 1017   CALL SETLOG(DLUP)
        RETURN
 
 1018   IF (ISSED) THEN
            CALL REMARK('Cannot change DOCONI in a SED')
        ELSE
            CALL SETLOG(DOCONI)
        END IF
        RETURN
 
 1019   CALL SETLOG(ERRCMT)
        RETURN
 
 1020   CALL SETKEY(FFCASE,CASTBL,CASTBX)
        RETURN
 
 1021   CALL SETINT(FLBINC,-99999,99999)
        RETURN
 
 1022   CALL SETINT(FLBINI,0,99999)
        RETURN
 
 1023   CALL SETLOG(FMSBRK)
        RETURN
 
 1024   CALL SETKEY(IDCASE,IDCTBL,IDCTBX)
        RETURN
 
 1025   CALL SETLOG(INDCMT)
        RETURN
 
 1026   CALL SETINT(INDCON,-60,60)
        RETURN
 
 1027   CALL SETINT(INDDO,0,60)
        RETURN
 
 1028   CALL SETLOG(INDDOC)
        RETURN
 
 1029   CALL SETINT(INDIF,0,60)
        RETURN
 
 1030   IF (ISSED) THEN
            CALL REMARK('Cannot change IOTHCO in a SED')
        ELSE
            CALL SETLOG(IOTHCO)
        END IF
        RETURN
 
 1031   CALL SETKEY(KWCASE,KWCTBL,KWCTBX)
        RETURN
 
 1032   CALL SETINT(LABELC,1,5)
        RETURN
 
 1033   CALL SETKEY(LABELF,LBFTBL,LBFTBX)
        RETURN
 
 1034   CALL SETINT(LMARGC,2,80)
        RETURN
 
 1035   CALL SETINT(LMARGS,7,40)
        RETURN
 
 1036   IF (ISSED) THEN
            CALL REMARK('Cannot change MOVEF in a SED')
        ELSE
            CALL SETLOG(MOVEF)
        END IF
        RETURN
 
 1037   IF (ISSED) THEN
            CALL REMARK('Cannot change RLBFMT in a SED')
        ELSE
            CALL SETLOG(RLBFMT)
        END IF
        RETURN
 
 1038   IF (ISSED) THEN
            CALL REMARK('Cannot change RLBSTM in a SED')
        ELSE
            CALL SETLOG(RLBSTM)
        END IF
        RETURN
 
 1039   CALL SETINT(RMARGC,10,132)
        RETURN
 
 1040   CALL SETINT(RMARGS,10,132)
        RETURN
 
 1041   CALL SETLOG(RMOPCF)
        RETURN
 
 1042   CALL SETINT(SEQDIG,1,8)
        RETURN
 
 1043   CALL SETCHR(SEQFIL)
        RETURN
 
 1044   CALL SETINT(SEQINC,1,999)
        RETURN
 
 1045   IF (ISSED) THEN
            CALL REMARK('Cannot change SEQINI in a SED')
        ELSE
            CALL SETINT(SEQINI,0,9999)
        END IF
        RETURN
 
 1046   CALL SETLOG(SEQRQD)
        RETURN
 
 1047   CALL SETINT(SLBINC,1,99999)
        RETURN
 
 1048   CALL SETINT(SLBINI,1,99999)
        RETURN
 
 1049   CALL SETVC2(SPAFT)
        RETURN
 
 1050   CALL SETVC2(SPBEF)
        RETURN
 
 1051   CALL SETKEY(STRCAS,CASTBL,CASTBX)
        RETURN
 
 1052   CALL SETLOG(TRACE)
        RETURN
 
 1053   CALL SETINT(VLEN,0,12)
        RETURN
 
C *******
C *
C * eXtended OPtions
C *
C *******
 
C XOP: nag_standard
 
 5000   IF (QUERY) THEN
            CALL ZMESS('"Nag_standard" requested:',1)
            IF (ZYESNO(-2).EQ.-3) RETURN
        END IF
 
        INDDO=3
        INDIF=3
        INDCON=-3
        INDCMT=.TRUE.
        CMMODE=1
*
        SPAFT(TIF,0)=0
        SPAFT(TOPEN,0)=0
        SPBEF(TTHEN,0)=0
*
        DO 5001 I=0,2
            SPBEF(TRPARN,I)=1
            SPAFT(TRPARN,I)=0
            SPBEF(TLPARN,I)=0
 5001       SPAFT(TLPARN,I)=1
*
        DO 5002 I=0,2
            SPBEF(TCOMMA,I)=0
 5002       SPAFT(TCOMMA,I)=1
*
        DO 5003 I=TLE,TGT
            DO 5003 J=0,2
                SPBEF(I,J)=1
 5003           SPAFT(I,J)=1
*
        DO 5004 I=TAND,TNEQV
            DO 5004 J=0,2
                SPBEF(I,J)=2
 5004           SPAFT(I,J)=2
*
        DO 5005 I=0,2
            SPBEF(TPLUS,I)=1
            SPAFT(TPLUS,I)=1
            SPBEF(TMINUS,I)=1
            SPAFT(TMINUS,I)=1
 5005   CONTINUE
*
        DO 5006 I=0,2
            SPBEF(TCOLON,I)=0
 5006       SPAFT(TCOLON,I)=1
*
        VLEN=6
        DLUP=.TRUE.
        BRKLIF=.TRUE.
        RETURN
 
 
C XOP: query
 
 5100   IF (QUERY) THEN
            CALL ZMESS('Ending QUERY mode..',1)
            QUERY=(ZYESNO(-2).EQ.-3)
        ELSE
            QUERY=.TRUE.
        END IF
 
        END
C ----------------------------------------------------------------------
C
C       B A D V A L  -  BAD VALue for a parameter
C
 
        SUBROUTINE BADVAL
 
        COMMON/OPTLCL/LHS,RHS,LPPOS,QUERY
        INTEGER LHS(134),RHS(134),LPPOS
        LOGICAL QUERY
 
        SAVE
 
        INTEGER I
        CHARACTER*132 ERRTXT
 
        INTRINSIC MAX
 
        INTEGER LENGTH
        EXTERNAL REMARK,ZITOF,ZFTOI,SCOPY,LENGTH
 
        I=MIN(LENGTH(RHS),40)
        CALL ZFTOI('] for option ',1,14,RHS(I+1),.FALSE.)
        LHS(40)=129
        CALL SCOPY(LHS,1,RHS,I+14)
        CALL ZITOF(RHS,1,132,ERRTXT,.TRUE.)
        CALL REMARK('Incorrect value ['//ERRTXT)
 
        END
C ----------------------------------------------------------------------
C
C       N O T S U B  -  (remark) Not a subscripted option
C
 
        SUBROUTINE NOTSUB
 
        COMMON/OPTLCL/LHS,RHS,LPPOS,QUERY
        INTEGER LHS(134),RHS(134),LPPOS
        LOGICAL QUERY
 
        SAVE
 
        CHARACTER*132 ERRTXT
 
        EXTERNAL ZITOF,REMARK
 
        CALL ZITOF(LHS,1,LPPOS,ERRTXT,.TRUE.)
        CALL REMARK('Not a subscripted option: '//ERRTXT)
 
        END
C ----------------------------------------------------------------------
C
C       M I S S U B  -  (remark) Missing subscript
C
 
        SUBROUTINE MISSUB
 
        COMMON/OPTLCL/LHS,RHS,LPPOS,QUERY
        INTEGER LHS(134),RHS(134),LPPOS
        LOGICAL QUERY
 
        SAVE
 
        CHARACTER*132 ERRTXT
 
        EXTERNAL ZITOF,REMARK
 
        CALL ZITOF(LHS,1,132,ERRTXT,.TRUE.)
        CALL REMARK('Missing subscript on option: '//ERRTXT)
 
        END
C ----------------------------------------------------------------------
C
C       B A D S U B  -  (remark) Bad subscript value
C
 
        SUBROUTINE BADSUB
 
        COMMON/OPTLCL/LHS,RHS,LPPOS,QUERY
        INTEGER LHS(134),RHS(134),LPPOS
        LOGICAL QUERY
 
        SAVE
 
        CHARACTER*132 ERRTXT
 
        EXTERNAL ZITOF,REMARK
 
        CALL ZITOF(LHS,1,132,ERRTXT,.TRUE.)
        CALL REMARK('Incorrect value for subscript: '//ERRTXT)
 
        END
C ----------------------------------------------------------------------
C
C       O U T O P T  -  Output requested option
C
 
        SUBROUTINE OUTOPT
 
        COMMON/OPTLCL/LHS,RHS,LPPOS,QUERY
        INTEGER LHS(134),RHS(134),LPPOS
        LOGICAL QUERY
 
        SAVE
 
        EXTERNAL ZCHOUT,PUTLIN,PUTC
 
        CALL ZCHOUT('Option change: ',1)
        CALL PUTLIN(LHS,1)
        CALL PUTC(61)
        CALL PUTLIN(RHS,1)
        CALL ZCHOUT(' [old value=] ',1)
 
        END
C ----------------------------------------------------------------------
C
C       S E T L O G  -  SET a LOGical parameter
C
 
        SUBROUTINE SETLOG(VAR)
        LOGICAL VAR
 
        COMMON/OPTLCL/LHS,RHS,LPPOS,QUERY
        INTEGER LHS(134),RHS(134),LPPOS
        LOGICAL QUERY
 
        INTEGER TFTBL(16)
 
        SAVE
 
        INTEGER TEMP
 
        INTEGER ZKWLUK,ZYESNO
        EXTERNAL ZKWLUK,ZYESNO,ZMESS
 
        DATA TFTBL/2,
     +       46,102,97,108,115,101,46,129,
     +       46,116,114,117,101,46,129/
 
        IF (LPPOS.GT.0) THEN
            CALL NOTSUB
        ELSE
            TEMP=ZKWLUK(RHS,TFTBL)
            IF (TEMP.LE.0) THEN
                CALL BADVAL
            ELSE IF (QUERY .AND. ((TEMP.EQ.2).NEQV.VAR)) THEN
                CALL OUTOPT
                IF (VAR) THEN
                    CALL ZMESS('..TRUE..',1)
                ELSE
                    CALL ZMESS('..FALSE..',1)
                END IF
                IF (ZYESNO(-2).EQ.-2) VAR=(TEMP.EQ.2)
            ELSE
                VAR=(TEMP.EQ.2)
            END IF
        END IF
 
        END
C ----------------------------------------------------------------------
C
C       S E T I N T  -  SET INTeger parameter
C
 
        SUBROUTINE SETINT(VAR,LB,UB)
        INTEGER VAR,LB,UB
 
        COMMON/OPTLCL/LHS,RHS,LPPOS,QUERY
        INTEGER LHS(134),RHS(134),LPPOS
        LOGICAL QUERY
 
        SAVE
 
        INTEGER PNTR,LASTP,TEMP,PTR
 
        INTEGER ZSCTOI,ZYESNO
        EXTERNAL ZSCTOI,SKIPBL,ZYESNO,PUTDEC,PUTC
 
        IF (LPPOS.NE.0) THEN
            CALL NOTSUB
        ELSE
            PNTR=1
            CALL SKIPBL(RHS,PNTR)
            LASTP=PNTR
C If front of RHS matches whole of LHS, we have an incremental setting,
C vis. LMARGS=LMARGS+3
            PTR=1
 100        IF (LHS(PTR).EQ.RHS(PNTR) .AND. LHS(PTR).NE.129) THEN
                PTR=PTR+1
                PNTR=PNTR+1
                GOTO 100
            END IF
C Make sure an incremental setting begins with + or -
            IF (LHS(PTR).EQ.129 .AND. (RHS(PNTR).EQ.43 .OR.
     +          RHS(PNTR).EQ.45)) THEN
C It is an incremental setting - fix check for legal number
                LASTP=PNTR
                TEMP=VAR+ZSCTOI(RHS,PNTR)
            ELSE
C Not an incremental setting - restore PNTR value
                PNTR=LASTP
                TEMP=ZSCTOI(RHS,PNTR)
            END IF
            IF (PNTR.EQ.LASTP .OR. TEMP.LT.LB .OR. TEMP.GT.UB .OR.
     +          RHS(PNTR).NE.129) THEN
                CALL BADVAL
            ELSE IF (QUERY .AND. TEMP.NE.VAR) THEN
                CALL OUTOPT
                CALL PUTDEC(VAR,1)
                CALL PUTC(10)
                IF (ZYESNO(-2).EQ.-2) VAR=TEMP
            ELSE
                VAR=TEMP
            END IF
        END IF
 
        END
C ----------------------------------------------------------------------
C
C       S E T C H R  -  SET CHaRacter variable
C
 
        SUBROUTINE SETCHR(VAR)
        INTEGER VAR
 
        COMMON/OPTLCL/LHS,RHS,LPPOS,QUERY
        INTEGER LHS(134),RHS(134),LPPOS
        LOGICAL QUERY
 
        SAVE
 
        INTEGER ZYESNO
        EXTERNAL ZYESNO,PUTC,ZMESS
 
        IF (LPPOS.NE.0) THEN
            CALL NOTSUB
        ELSE IF (RHS(1).NE.39 .OR. RHS(3).NE.39 .OR.
     +           RHS(4).NE.129) THEN
            CALL BADVAL
        ELSE IF (QUERY .AND. VAR.NE.RHS(2)) THEN
            CALL OUTOPT
            CALL PUTC(39)
            CALL PUTC(VAR)
            CALL ZMESS('''',1)
            IF (ZYESNO(-2).EQ.-2) VAR=RHS(2)
        ELSE
            VAR=RHS(2)
        END IF
 
        END
C ----------------------------------------------------------------------
C
C       S E T V E C  -  Set vector element
C
 
        SUBROUTINE SETVEC(VECTOR)
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.4
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
        INTEGER VECTOR(-2:TKLAST)
 
        COMMON/OPTLCL/LHS,RHS,LPPOS,QUERY
        INTEGER LHS(134),RHS(134),LPPOS
        LOGICAL QUERY
 
        SAVE
 
        INTEGER PNTR,I,TEMP,LASTP
 
        INTEGER EVTSUB
 
        INTEGER ZSCTOI,ZYESNO
        EXTERNAL ZSCTOI,ZYESNO,PUTDEC,PUTC
 
        IF (EVTSUB(I).EQ.-1) RETURN
        PNTR=1
        LASTP=PNTR
        TEMP=ZSCTOI(RHS,PNTR)
        IF (PNTR.EQ.LASTP) THEN
            CALL BADVAL
        ELSE IF (QUERY .AND. VECTOR(I).NE.TEMP) THEN
            CALL OUTOPT
            CALL PUTDEC(VECTOR(I),1)
            CALL PUTC(10)
            IF (ZYESNO(-2).EQ.-2) VECTOR(I)=TEMP
        ELSE
            VECTOR(I)=TEMP
        END IF
 
        END
C ----------------------------------------------------------------------
C
C       S E T V C 2  -  Set element of 2-dimensional vector
C
 
        SUBROUTINE SETVC2(VECTOR)
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.4
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
        INTEGER VECTOR(-2:TKLAST,0:2)
 
        COMMON/OPTLCL/LHS,RHS,LPPOS,QUERY
        INTEGER LHS(134),RHS(134),LPPOS
        LOGICAL QUERY
 
        SAVE
 
        INTEGER PNTR,I,TEMP(0:2),LASTP,ROW
 
        INTEGER EVTSUB
 
        INTEGER ZSCTOI,ZYESNO
        EXTERNAL ZSCTOI,ZYESNO,PUTDEC,PUTC
 
        IF (EVTSUB(ROW).EQ.-1) RETURN
        PNTR=1
        LASTP=PNTR
        DO 100 I=0,2
            TEMP(I)=ZSCTOI(RHS,PNTR)
            IF (PNTR.EQ.LASTP) THEN
                CALL BADVAL
                RETURN
            END IF
            IF (RHS(PNTR).NE.129) PNTR=PNTR+1
            LASTP=PNTR
 100    CONTINUE
        IF (QUERY .AND. (TEMP(0).NE.VECTOR(ROW,0) .OR.
     +     TEMP(1).NE.VECTOR(ROW,1) .OR. TEMP(2).NE.VECTOR(ROW,2))) THEN
            CALL OUTOPT
            DO 200 I=0,2
                CALL PUTDEC(VECTOR(ROW,I),1)
 200            CALL PUTC(32)
            CALL PUTC(10)
            IF (ZYESNO(-2).EQ.-3) RETURN
        END IF
        DO 300 I=0,2
 300        VECTOR(ROW,I)=TEMP(I)
 
        END
C ----------------------------------------------------------------------
C
C       S E T K E Y  -  Set (integer) according to keyword value
C
 
        SUBROUTINE SETKEY(VAR,TABLE,TBX)
        INTEGER VAR,TABLE(*),TBX(*)
 
        COMMON/OPTLCL/LHS,RHS,LPPOS,QUERY
        INTEGER LHS(134),RHS(134),LPPOS
        LOGICAL QUERY
 
        SAVE
 
        INTEGER I,J,K,L
 
        INTEGER ZKWLUK,ZYESNO
        EXTERNAL ZKWLUK,ZYESNO,ZPTMES
 
        IF (LPPOS.NE.0) THEN
            CALL NOTSUB
        ELSE
            I=ZKWLUK(RHS,TABLE)
            IF (I.LE.0) THEN
                CALL BADVAL
            ELSE IF (QUERY .AND. VAR.NE.TBX(I)) THEN
                CALL OUTOPT
                J=1
 100            IF (TBX(J).NE.VAR) THEN
                    J=J+1
                    GOTO 100
                END IF
                L=1
                DO 300 K=2,J
 200                IF (TABLE(L).NE.129) THEN
                        L=L+1
                        GOTO 200
                    END IF
                    L=L+1
 300            CONTINUE
                CALL ZPTMES(TABLE(L),1)
                IF (ZYESNO(-2).EQ.-2) VAR=TBX(I)
            ELSE
                VAR=TBX(I)
            END IF
        END IF
 
        END
C ----------------------------------------------------------------------
C
C       E V T S U B  -  Evaluate Token-name Subscript
C
 
        INTEGER FUNCTION EVTSUB(RESULT)
        INTEGER RESULT
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.4
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
        COMMON/TNAMES/TOKNAM
        CHARACTER*6 TOKNAM(-2:TKLAST)
 
        COMMON/OPTLCL/LHS,RHS,LPPOS,QUERY
        INTEGER LHS(134),RHS(134),LPPOS
        LOGICAL QUERY
 
        SAVE
 
        CHARACTER*6 SUBNAM
        INTEGER I
 
        INTEGER LENGTH
        EXTERNAL LENGTH,ZTOCAP,ZITOF
 
        IF (LPPOS.EQ.0 .OR. LHS(LENGTH(LHS)).NE.41) THEN
            CALL MISSUB
            EVTSUB=-1
        ELSE
            SUBNAM='      '
            CALL ZTOCAP(LHS(LPPOS+1))
            I=LENGTH(LHS(LPPOS+1))
            CALL ZITOF(LHS,LPPOS+1,LPPOS+I-1,SUBNAM,.FALSE.)
            I=-2
 200        IF (I.LT.TKLAST .AND. TOKNAM(I).NE.SUBNAM) THEN
                I=I+1
                GOTO 200
            END IF
            IF (TOKNAM(I).NE.SUBNAM) THEN
                CALL BADSUB
                EVTSUB=-1
            ELSE
                EVTSUB=-2
                RESULT=I
            END IF
        END IF
 
        END
